perm filename PASS3.SAI[HAL,HE]4 blob
sn#205226 filedate 1976-03-08 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00018 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 IFCR ¬DECLARATION(EXTENDED_COMPILATION)
C00006 00003 ! Declarations, overall description
C00009 00004 ! EMITOFFSET, EMITSMLBLK
C00015 00005 ! EMITEXPR: ONEARG, TWOARGS, THREEARGS
C00019 00006 ! EMITEXPR: variable, constant, specval, force
C00024 00007 ! EMITEXPR: expression
C00029 00008 ! EMITBOOL
C00033 00009 ! TSCAN: STMNT, VARIABLE, PROG
C00037 00010 ! TSCAN: BLOCK
C00049 00011 ! TSCAN: COBLOCK
C00052 00012 ! TSCAN: FORR, WHIL, IFF
C00058 00013 ! TSCAN: ASSIGNMENT, PRNT, GASSIGN, ALSODO
C00062 00014 ! TSCAN: CMON, CMABLE
C00066 00015 ! TSCAN: MOVE$, CENTER, STOP, COMMENT, AFFIX, UNFIX
C00073 00016 ! TSCAN: EVDO, SPECVAL
C00074 00017 ! NULL, UNRECOGNIZED, Matching ENDs
C00075 00018 ! Bugs
C00076 ENDMK
C⊗;
IFCR ¬DECLARATION(EXTENDED_COMPILATION)
THENC
ENTRY;
BEGIN "PASS3"
IFCR ¬DECLARATION(CREFFING) THENC DEFINE CREFFING = "FALSE"; ENDC
IFCR ¬ CREFFING THENC
COMMENT: Source file requirements;
REQUIRE "ABBREV.SAI[S,RHT]" SOURCE_FILE;
REQUIRE "RECAUX.HDR[S,RHT]" SOURCE_FILE;
REQUIRE "HALREC.SAI[HAL,HE]" SOURCE_FILE ;
ENDC
REDEFINE $$PRGID "[]" = ["PASS3"];
IFCR CREFFING THENC REQUIRE $$PRGID MESSAGE; ENDC
REQUIRE "EMITER.HDR[HAL,HE]" SOURCE_FILE;
REQUIRE "INTDEF.SAI[HAL,HE]" SOURCE_FILE;
ENDC
REQUIRE "EMITER.REL[HAL,HE]" LOAD_MODULE;
! Standard emitter;
! REQUIRE "TCALC.HDR[HAL,HE]" SOURCE_FILE;
EXTERNAL PROCEDURE TRJCLC(RANY MOV; RANY ITEMVAR WORLD);
EXTERNAL PROCEDURE CENTCLC(RANY MOV);
EXTERNAL PROCEDURE STOPCLC(RANY MOV);
! Declarations, overall description;
RCELL USEDVARS; ! A list of variables as they appear. Used to
generate the needed list of graph node calculators;
! The word that heads a constant gives its type. These are they:;
DEFINE SCLID = 1;
DEFINE VCTID = 2;
DEFINE TRNID = 3;
! This file contains all the routines necessary for implementing the
third pass of HAL, that is, the code generator.
The principal routine is TSCAN, which generates code for the root of
the bound parse tree and calls itself recursively for the rest. The
structures in this tree are defined in HALREC[HAL,RHT], page three.
TSCAN is a large IF-THEN-ELSE-IF-THEN chain which determines which of
the various possible structures is present. If it is some kind of
statement, then appropriate pseudo-code is emitted. The preparation
of this code may require that code for the evaluation of an
expression. Such code is prepared in the recursive procedure
EMITEXPR, which performs type-consistency checking (but not constant
folding, which could be done here). Code for boolean tests is
prepared by EMITBOOL.
All code emission is done through the routine EMIT, to be found in
EMITER.SAI, which takes arguments specifying what output file to use
(e.g., pseudo-code or constant area), the data to output, and whether
to treat it as an instruction, an octal constant, a label
declaration, or repeatedly to produce the rel file. ;
! EMITOFFSET, EMITSMLBLK;
INTERNAL PROCEDURE EMITOFFSET(INTEGER PC;RVAR VARBL);
BEGIN "emitoffset"
! Outputs into the file PC the offset of VARBL, making a remark;
INTEGER DUMY;
MAKE_REMARK(PC,CVIS(VARIABLE:NAME[VARBL],DUMY));
EMIT(PC,VARIABLE:OFFSET[VARBL],CONST);
END "emitoffset";
INTEGER PROCEDURE EMITSMLBLK
(INTEGER LENGTH; REFERENCE REAL FIRST_ELT; BOOLEAN REF (FALSE));
BEGIN "emitsmlblk"
! Emits a constant in the small block area. The length is
given, as is the first element, so that the whole thing can be
grabbed by location. Note that LENGTH must not be greater than
3. The label of the block is returned as the result if REF is
true, otherwise, no label is emitted.
;
OWN INTEGER ARRAY DATA [1:7]; ! 2*maxlength + 1 long;
INTEGER ARRAY RELOC [1:7];
INTEGER J, ADDR, K;
IF LENGTH > 3
THEN BEGIN
COMERR("EMITSMLBLK cannot handle length = " & CVS(LENGTH));
LENGTH ← 3;
END;
IF REF
THEN BEGIN
DATA[1] ← GENLABEL;
RELOC[1] ← SYMDEC;
K ← 2;
END
ELSE K ← 1; ! Place for next entry in DATA, RELOC;
ADDR ← LOC(FIRST_ELT);
FOR J ← 0 STEP 1 UNTIL LENGTH-1 DO
BEGIN "convert";
INT_TO_11FLOAT(DATA[K],DATA[K+1],MEM[ADDR + J,REAL]);
RELOC[K] ← RELOC[K+1] ← CONST;
K ← K + 2;
END "convert";
EMIT(SMLBLK,DATA[1],RELOC[1],K-1);
RETURN(IF REF THEN DATA[1] ELSE -1);
END "emitsmlblk";
! EMITEXPR: ONEARG, TWOARGS, THREEARGS;
INTERNAL RECURSIVE INTEGER PROCEDURE EMITEXPR (REXPR XPRESS);
! Emits code for XPRESS, the value of which is to be left at top
of stack, returns the type of the expression. FRAME_DTYPE is
never returned. It is coerced to TRANS_DTYPE;
BEGIN "emitexpr"
INTEGER RTYPE, DTYPE;
RECURSIVE PROCEDURE ONEARG(INTEGER ARG1TYPE,OPERATION,RESTYPE);
BEGIN ! Pick up one argument, evaluate;
REXPR XXX;
XXX ← XPRESS; ! because of a SAIL Bug;
MAKE_REMARK(PSDCODE,"first argument");
IF EMITEXPR(CELL:CAR[EXPRN:ARGS[XXX]]) ≠ ARG1TYPE
THEN COMERR("Wrong type of argument",XXX);
EMIT(PSDCODE,OPERATION,PSINST);
DTYPE ← RESTYPE;
END;
RECURSIVE PROCEDURE TWOARGS
(INTEGER ARG1TYPE,ARG2TYPE,OPERATION,RESTYPE);
BEGIN ! Pick up two arguments, evaluate them;
DEFINE CADR(X) = "CELL:CAR[CELL:CDR[X]]";
REXPR XXX;
XXX ← XPRESS; ! because of a SAIL Bug;
MAKE_REMARK(PSDCODE,"first argument");
IF EMITEXPR(CELL:CAR[EXPRN:ARGS[XXX]]) ≠ ARG1TYPE
THEN COMERR("Wrong type for first argument",XXX);
MAKE_REMARK(PSDCODE,"second argument");
IF EMITEXPR(CADR(EXPRN:ARGS[XXX])) ≠ ARG2TYPE
THEN COMERR("Wrong type for second argument",XXX);
EMIT(PSDCODE,OPERATION,PSINST);
DTYPE ← RESTYPE;
END;
RECURSIVE PROCEDURE THREEARGS
(INTEGER ARG1TYPE,ARG2TYPE,ARG3TYPE,OPERATION,RESTYPE);
BEGIN ! Pick up three arguments, evaluate;
DEFINE CADR(X) = "CELL:CAR[CELL:CDR[X]]";
DEFINE CADDR(X) = "CELL:CAR[CELL:CDR[CELL:CDR[X]]]";
REXPR XXX;
XXX ← XPRESS; ! because of a SAIL Bug;
MAKE_REMARK(PSDCODE,"first argument");
IF EMITEXPR(CELL:CAR[EXPRN:ARGS[XXX]]) ≠ ARG1TYPE
THEN COMERR("Wrong type for first argument",XXX);
MAKE_REMARK(PSDCODE,"second argument");
IF EMITEXPR(CADR(EXPRN:ARGS[XXX])) ≠ ARG2TYPE
THEN COMERR("Wrong type for second argument",XXX);
MAKE_REMARK(PSDCODE,"third argument");
IF EMITEXPR(CADDR(EXPRN:ARGS[XXX])) ≠ ARG3TYPE
THEN COMERR("Wrong type for third argument",XXX);
EMIT(PSDCODE,OPERATION,PSINST);
DTYPE ← RESTYPE;
END;
! EMITEXPR: variable, constant, specval, force;
PRELOAD_WITH PUSH_PSOP, DUMMY;
OWN INTEGER ARRAY DATA[0:1];
PRELOAD_WITH PSINST, SYMREF;
OWN INTEGER ARRAY RELOC [0:1];
INTEGER LAB;
RTYPE ← RECTYPE(XPRESS);
! A variable?;
IF RTYPE = LOC(VARIABLE)
THEN BEGIN "variable"
EMIT(PSDCODE,GTVAL_PSOP,PSINST);
EMITOFFSET(PSDCODE,XPRESS);
DTYPE ← VARIABLE:DATATYPE[XPRESS];
USEDVARS ← CONS(XPRESS,USEDVARS);
END "variable"
! A constant?;
ELSE IF RTYPE = LOC(SVAL)
THEN BEGIN "scalar"
EMIT(SMLBLK,SCLID,CONST); ! Header for typing;
LAB ← EMITSMLBLK(1,SVAL:VAL[XPRESS],TRUE);
DATA[1] ← LAB;
EMIT(PSDCODE,DATA[0],RELOC[0],2);
DTYPE ← SVAL_DTYPE;
END "scalar"
ELSE IF RTYPE = LOC(V3ECT)
THEN BEGIN "vector"
EMIT(SMLBLK,VCTID,CONST); ! Header for typing;
LAB ← EMITSMLBLK(3,V3ECT:X[XPRESS],TRUE);
DATA[1] ← LAB;
EMIT(PSDCODE,DATA[0],RELOC[0],2);
DTYPE ← V3ECT_DTYPE;
END "vector"
ELSE IF RTYPE = LOC(ROTN)
THEN BEGIN "rot" ! Will output the equivalent trans;
EMIT(SMLBLK,TRNID,CONST); ! Header for typing;
LAB ← EMITSMLBLK(3,ROTN:RMX[XPRESS][1,1],TRUE);
EMITSMLBLK(1,0.0); ! This puts the fourth row in;
EMITSMLBLK(3,ROTN:RMX[XPRESS][2,1]);
EMITSMLBLK(1,0.0); ! This puts the fourth row in;
EMITSMLBLK(3,ROTN:RMX[XPRESS][3,1]);
EMITSMLBLK(1,0.0); ! This puts the fourth row in;
EMITSMLBLK(3,V3ECT:X[NILVECT]); ! The fourth column;
EMITSMLBLK(1,0.0); ! This puts the fourth row in;
DATA[1] ← LAB;
EMIT(PSDCODE,DATA[0],RELOC[0],2);
DTYPE ← ROTN_DTYPE;
END "rot"
ELSE IF RTYPE = LOC(TRANS)
THEN BEGIN "trans"
EMIT(SMLBLK,TRNID,CONST); ! Header for typing;
LAB ← EMITSMLBLK(3,ROTN:RMX[TRANS:R[XPRESS]][1,1],TRUE);
EMITSMLBLK(1,0.0); ! This puts the fourth row in;
EMITSMLBLK(3,ROTN:RMX[TRANS:R[XPRESS]][2,1]);
EMITSMLBLK(1,0.0); ! This puts the fourth row in;
EMITSMLBLK(3,ROTN:RMX[TRANS:R[XPRESS]][3,1]);
EMITSMLBLK(1,0.0); ! This puts the fourth row in;
EMITSMLBLK(3,V3ECT:X[TRANS:P[XPRESS]]); ! The fourth column;
EMITSMLBLK(1,0.0); ! This puts the fourth row in;
DATA[1] ← LAB;
EMIT(PSDCODE,DATA[0],RELOC[0],2);
DTYPE ← TRANS_DTYPE;
END "trans"
ELSE IF RTYPE = LOC(FRAME)
THEN BEGIN "frame" ! Recursive call to pick up the trans inside;
EMITEXPR(FRAME:VAL[XPRESS]);
DTYPE ← FRAME_DTYPE;
END "frame"
! A specval?;
ELSE IF RTYPE = LOC(SPECVAL)
THEN BEGIN "specval"
IF SPECVAL:OLD[XPRESS]
THEN EMIT(PSDCODE,GTOLD_PSOP,PSINST)
ELSE EMIT(PSDCODE,GTNEW_PSOP,PSINST);
DTYPE ← SPECVAL:TYPE[XPRESS];
END "specval"
! A force?;
ELSE IF RTYPE = LOC(FORCE)
THEN BEGIN "force"
EMIT(PSDCODE,GETFORCE_PSOP,PSINST);
EMIT(PSDCODE,FORCE:OFFSET[XPRESS],CONST);
DTYPE ← SVAL_DTYPE;
END "force"
! EMITEXPR: expression;
! An expression?;
ELSE IF RTYPE = LOC(EXPRN)
THEN BEGIN "recurse"
INTEGER OPR;
OPR ← EXPRN:OP[XPRESS];
IF OPR < 0 ∨ OPR ≥ LAST_OP
THEN BEGIN
COMERR("Illegal expression",XPRESS);
DTYPE ← 0;
END
ELSE CASE OPR OF
BEGIN "case"
[NO_OP]
DTYPE ← EMITEXPR(CELL:CAR[EXPRN:ARGS[XPRESS]]);
[SADD_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SADD_PSOP,SVAL_DTYPE);
[SNEG_OP]
ONEARG(SVAL_DTYPE,SNEG_PSOP,SVAL_DTYPE);
[SSUB_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SSUB_PSOP,SVAL_DTYPE);
[SMUL_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SMUL_PSOP,SVAL_DTYPE);
[SDIV_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SDIV_PSOP,SVAL_DTYPE);
[SLT_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SSUB_PSOP,SVAL_DTYPE);
[SEQ_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SSUB_PSOP,SVAL_DTYPE);
[SLE_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SSUB_PSOP,SVAL_DTYPE);
[SGE_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SSUB_PSOP,SVAL_DTYPE);
[SNE_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SSUB_PSOP,SVAL_DTYPE);
[SGT_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SSUB_PSOP,SVAL_DTYPE);
[VMAGN_OP]
ONEARG(V3ECT_DTYPE,VMAGN_PSOP,SVAL_DTYPE);
[VDOT_OP]
TWOARGS(V3ECT_DTYPE,V3ECT_DTYPE,VDOT_PSOP,SVAL_DTYPE);
[VMAKE_OP]
THREEARGS(SVAL_DTYPE,SVAL_DTYPE,SVAL_DTYPE,VMAKE_PSOP,V3ECT_DTYPE);
[SVMUL_OP]
TWOARGS(SVAL_DTYPE,V3ECT_DTYPE,SVMUL_PSOP,V3ECT_DTYPE);
[VADD_OP]
TWOARGS(V3ECT_DTYPE,V3ECT_DTYPE,VADD_PSOP,V3ECT_DTYPE);
[RVMUL_OP]
TWOARGS(ROTN_DTYPE,V3ECT_DTYPE,TVMUL_PSOP,V3ECT_DTYPE);
[TVMUL_OP]
TWOARGS(TRANS_DTYPE,V3ECT_DTYPE,TVMUL_PSOP,V3ECT_DTYPE);
[AXW_ROTN_OP]
TWOARGS(V3ECT_DTYPE,V3ECT_DTYPE,VSAXWR_PSOP,ROTN_DTYPE);
[TMAKE_OP]
TWOARGS(ROTN_DTYPE,V3ECT_DTYPE,TMAKE_PSOP,TRANS_DTYPE);
[TVADD_OP]
TWOARGS(TRANS_DTYPE,V3ECT_DTYPE,TVADD_PSOP,TRANS_DTYPE);
[TTMUL_OP]
TWOARGS(TRANS_DTYPE,TRANS_DTYPE,TTMUL_PSOP,TRANS_DTYPE);
[TINVRT_OP]
ONEARG(TRANS_DTYPE,TINVRT_PSOP,TRANS_DTYPE);
[FMAKE_OP]
TWOARGS(ROTN_DTYPE,V3ECT_DTYPE,TMAKE_PSOP,TRANS_DTYPE);
[INVALID_OP]
COMERR("Invalid operator",XPRESS)
END "case";
IF DTYPE ≠ EXPRN:DATATYPE[XPRESS]
THEN COMERR("Type consistency error in EMITEXPR: " & CVS(DTYPE) &" ≠ " &
CVS(EXPRN:DATATYPE[XPRESS]) & ".",XPRESS);
END "recurse"
ELSE BEGIN
COMERR("Garbage expression",XPRESS);
DTYPE ← 0;
END;
IF DTYPE = FRAME_DTYPE THEN DTYPE ← TRANS_DTYPE;
RETURN(DTYPE);
END "emitexpr";
! EMITBOOL;
PROCEDURE EMITBOOL(REXPR CONDITION; INTEGER DESTTRUE (0), DESTFALSE (0));
BEGIN "emitbool"
! Generates code to evaluate the condition. If it succeeds,
there should be a jump to DESTTRUE, if false, to DESTFALSE. If
either is 0, instead of jumping there, fall through;
INTEGER CONDCODE, RTYPE;
RTYPE ← RECTYPE(CONDITION);
IF RTYPE = LOC(SVAL) OR
(RTYPE = LOC(VARIABLE) AND VARIABLE:DATATYPE[CONDITION] = SVAL_DTYPE)
THEN CONDCODE ← 6
ELSE IF RTYPE ≠ LOC(EXPRN)
THEN COMERR("Not a boolean",CONDITION)
ELSE CASE EXPRN:OP[CONDITION] OF
BEGIN ! The code for JUMPC depends on the type of test;
[NO_OP] CONDCODE ← 6; ! S≠0;
[SLT_OP] CONDCODE ← 1; ! S<S;
[SEQ_OP] CONDCODE ← 2; ! S=S;
[SLE_OP] CONDCODE ← 3; ! S≤S;
[SGE_OP] CONDCODE ← 5; ! S≥S;
[SNE_OP] CONDCODE ← 6; ! S≠S;
[SGT_OP] CONDCODE ← 7 ! S>S;
END;
IF DESTTRUE
THEN BEGIN "tjump"
! Put the tested result on the stack;
IF EMITEXPR(CONDITION) ≠ SVAL_DTYPE
THEN COMERR("Non-scalar boolean",CONDITION);
EMIT(PSDCODE,JUMPC_PSOP,PSINST,1); ! JUMPC;
EMIT(PSDCODE,CONDCODE,CONST,1); ! (condition);
EMIT(PSDCODE,DESTTRUE,SYMREF,1); ! (ref) DESTTRUE;
IF DESTFALSE
THEN BEGIN "tfjump"
EMIT(PSDCODE,JUMP_PSOP,PSINST,1); ! JUMP;
EMIT(PSDCODE,DESTFALSE,SYMREF,1); ! (ref) DESTFALSE;
END "tfjump"
END "tjump"
ELSE IF DESTFALSE
THEN BEGIN "fjump"
! Put the tested result on the stack;
CONDCODE ← CONDCODE XOR '4; ! Complement condition;
IF EMITEXPR(CONDITION) ≠ SVAL_DTYPE
THEN COMERR("Non-scalar boolean",CONDITION);
EMIT(PSDCODE,JUMPC_PSOP,PSINST,1); ! JUMPC;
EMIT(PSDCODE,CONDCODE,CONST,1); ! ¬ (condition);
EMIT(PSDCODE,DESTFALSE,SYMREF,1); ! (ref) DESTFALSE;
END "fjump";
END "emitbool";
! TSCAN: STMNT, VARIABLE, PROG;
INTERNAL RECURSIVE PROCEDURE TSCAN (RANY PARSETREE);
BEGIN "tscan"
! TSCAN takes a parse tree and interprets its nodes, calling
appropriate routines to prepare code for each node;
INTEGER STYP, ! Statement type;
LAB1, LAB2, LAB3, LAB4;
! Save labels across recursive calls. Cannot
save in DATA since that is an OWN array;
RPTR(STMNT) STATEMENT;
LABEL MIDLABEL, ENDLABEL; ! This is to prevent parse stack overflow;
OWN INTEGER OFS; ! The current offset for variables;
INITIALIZE (OFS ← '30);
STYP ← RECTYPE(PARSETREE);
IF STYP = LOC(STMNT) THEN
BEGIN "stmnt"
! Eventually will want to output labelling information here;
STATEMENT ← PARSETREE;
PARSETREE ← STMNT:SEMANTICS[PARSETREE];
STYP ← RECTYPE(PARSETREE);
END "stmnt";
IF STYP = LOC(VARIABLE) THEN
! Just ignore it. Variable declarations are treated with
block entry and exit;
ELSE IF STYP = LOC(PROG) THEN
BEGIN "prog"
PRELOAD_WITH 0, 0;
INTEGER OWN ARRAY DATA[0:1];
PRELOAD_WITH CONST, CONST;
INTEGER OWN ARRAY RELOC[0:1];
OFS ← '20;
MAKE_REMARK(PSDCODE,"PROG");
EMIT(PSDCODE,PROG_PSOP,PSINST); ! Make mechanism variables;
TSCAN(PROG:CODE[PARSETREE]);
EMIT(PSDCODE,ENDP_PSOP,PSINST); ! Clean up mechanism variables;
MAKE_REMARK(PSDCODE,"End of PROG");
CLOSEOUT; ! Closes the output file;
END "prog"
! TSCAN: BLOCK;
ELSE IF STYP = LOC(BLOCK) THEN
BEGIN "block"
RCELL C; ! Holds variable list and current tail of block;
INTEGER DUMY, SAVOFS; ! Holds OFS for the duration;
RVAR VARBL; ! Temporary: variable under consideration;
MAKE_REMARK(PSDCODE,"BLOCK");
SAVOFS ← OFS; ! We will assign new offsets in this block.
! Declare non-global variables;
C ← BLOCK:VARS[PARSETREE];
IF C ≠ RNULL
THEN EMIT(PSDCODE,MVAR_PSOP,PSINST); ! variable declaration;
WHILE C ≠ RNULL DO
BEGIN "vardec"
VARBL ← LLOP(C);
IF ¬GLBAL_ON(VARIABLE:ATTRIBUTES[VARBL])
THEN BEGIN ! List each non-global variable;
VARIABLE:OFFSET[VARBL] ← OFS ← OFS+2;
EMITOFFSET(PSDCODE,VARBL);
END;
END "vardec";
IF BLOCK:VARS[PARSETREE] ≠ RNULL
THEN EMIT(PSDCODE,0,CONST); ! zero at end of variable list;
! Link global variables;
C ← BLOCK:VARS[PARSETREE];
WHILE C ≠ RNULL DO
BEGIN "glbdec"
VARBL ← LLOP(C);
IF GLBAL_ON(VARIABLE:ATTRIBUTES[VARBL])
THEN BEGIN ! List each global variable;
INTEGER R50; ! Holds the radix 50 of the name;
INTEGER TEMP;
EMIT(PSDCODE,GLBLNK_PSOP,PSINST);
VARIABLE:OFFSET[VARBL] ← OFS ← OFS+2;
EMITOFFSET(PSDCODE,VARBL);
R50 ← CVSIX(CVIS(VARIABLE:NAME[VARBL],DUMY));
TEMP ← R50 LAND '177777; ! First part of name;
EMIT(PSDCODE,TEMP,CONST);
TEMP ← (R50 LSH -16) LAND '177777; ! Second part of name;
EMIT(PSDCODE,TEMP,CONST);
END;
END "glbdec";
! Declare each event;
C ← BLOCK:EVTS[PARSETREE];
IF C ≠ RNULL
THEN EMIT(PSDCODE,MAKEVT_PSOP,PSINST);
WHILE C ≠ RNULL DO
BEGIN ! List each event;
VARBL ← LLOP(C);
VARIABLE:OFFSET[VARBL] ← OFS ← OFS+2;
EMITOFFSET(PSDCODE,VARBL);
END;
IF BLOCK:EVTS[PARSETREE] ≠ RNULL
THEN EMIT(PSDCODE,0,CONST); ! zero at end of event list;
! Set up force variables;
C ← BLOCK:FORCES[PARSETREE];
IF C ≠ RNULL
THEN MAKE_REMARK(PSDCODE,"Form force variable");
WHILE C ≠ RNULL DO
BEGIN "blkforce"
! <put fdirect and mdirect on stack> MAKFORCE <offset> <mech. bits>;
RPTR(FORCE) FRC;
FRC ← LLOP(C);
EMITEXPR(FORCE:FDIRECT[FRC]); ! The direction;
EMITEXPR(FORCE:MDIRECT[FRC]); ! The moment;
EMIT(PSDCODE,MAKFORCE_PSOP,PSINST);
EMIT(PSDCODE,FORCE:OFFSET[FRC]←OFS←OFS+2,CONST);
EMIT(PSDCODE,'4,CONST); ! For now, only can use blue arm;
END "blkforce";
! Form each condition monitor;
C ← BLOCK:CMONS[PARSETREE];
WHILE C ≠ RNULL DO
BEGIN "blkcmon"
INTEGER CTYPE; ! 0 for expression or variable, 1 for event;
RPTR(CMON) MONITOR;
MONITOR ← LLOP(C);
! JUMP_PSOP LAB1 (ref), (dec) LAB2: "condition monitor
checker" CMSKED, <time: 100 for variable, 0 for event>,
[<code for boolean condition, if variable>], CMTRIG,
<code for conclusion>, JUMP (ref) LAB2, "create condition
monitor", (dec) LAB1: CMMAK <offset>, <event to wait for,
or 0>, (ref) LAB2;
CTYPE ← IF RECTYPE(CMON:CONDITION[MONITOR]) = LOC(VARIABLE)
AND VARIABLE:DATATYPE[CMON:CONDITION[MONITOR]] = EVENT_DTYPE
THEN 1 ELSE 0;
EMIT(PSDCODE,JUMP_PSOP,PSINST); ! Jump to declaration;
LAB1 ← GENLABEL; ! Declaration;
EMIT(PSDCODE,LAB1,SYMREF);
MAKE_REMARK(PSDCODE,"Condition monitor checker");
LAB2 ← GENLABEL; ! start address;
EMIT(PSDCODE,LAB2,SYMDEC);
EMIT(PSDCODE,CMSKED_PSOP,PSINST);
IF CTYPE = 0
THEN BEGIN "cmexpr" ! An expression to be evaluated;
EMIT(PSDCODE,100,CONST); ! Waiting interval;
EMITBOOL(CMON:CONDITION[MONITOR],0,LAB2);
END "cmexpr"
ELSE BEGIN "cmevt" ! An event to wait for;
EMIT(PSDCODE,0,CONST); ! Waiting interval;
END "cmevt";
EMIT(PSDCODE,CMTRIG_PSOP,PSINST);
TSCAN(CMON:CONCLUSION[MONITOR]);
EMIT(PSDCODE,JUMP_PSOP,PSINST);
EMIT(PSDCODE,LAB2,SYMREF);
MAKE_REMARK(PSDCODE,"Create condition monitor");
EMIT(PSDCODE,LAB1,SYMDEC);
EMIT(PSDCODE,CMMAK_PSOP,PSINST);
EMIT(PSDCODE,CMON:OFFSET[MONITOR]←OFS←OFS+2,CONST);
IF CTYPE = 0
THEN EMIT(PSDCODE,0,CONST) ! No event to wait for;
ELSE ! Wait for event;
EMITOFFSET(PSDCODE,CMON:CONDITION[MONITOR]);
EMIT(PSDCODE,LAB2,SYMREF);
END "blkcmon";
! Form the calculators local to this block;
C ← BLOCK:CLCS[PARSETREE];
WHILE C ≠ RNULL DO
BEGIN "blkclc"
RVAR ITEMVAR NEED;
RPTR(CALCULATOR) CALC;
CALC ← LLOP(C);
! MEXP_PSOP, <needed list>, <0>, SYMREF (LAB1), <offset> ;
EMIT(PSDCODE,MEXP_PSOP,PSINST);
FOREACH NEED SUCH THAT NEED IN CALCULATOR:NEEDED[CALC] DO
EMITOFFSET(PSDCODE,∂(NEED));
EMIT(PSDCODE,0,CONST);
LAB1 ← GENLABEL;
EMIT(PSDCODE,LAB1,SYMREF);
CALCULATOR:OFFSET[CALC] ← OFS ← OFS + 2;
EMIT(PSDCODE,OFS,CONST);
! JUMP_PSOP, SYMREF (LAB2), LAB1: <code for expression>,
ENDCLC_PSOP, LAB2: ;
EMIT(PSDCODE,JUMP_PSOP,PSINST);
LAB2 ← GENLABEL;
EMIT(PSDCODE,LAB2,SYMREF);
EMIT(PSDCODE,LAB1,SYMDEC);
EMITEXPR(CALCULATOR:FORM[CALC]);
EMIT(PSDCODE,ENDCLC_PSOP,PSINST);
EMIT(PSDCODE,LAB2,SYMDEC);
END "blkclc";
! Generate the code for the statements in the block;
C ← BLOCK:CODE[PARSETREE];
WHILE C ≠ RNULL DO
TSCAN(LLOP(C));
MAKE_REMARK(PSDCODE,"Block end cleanup");
! Get rid of condition monitors;
C ← BLOCK:CMONS[PARSETREE];
IF C ≠ RNULL
THEN EMIT(PSDCODE,CMDEST_PSOP,PSINST);
WHILE C ≠ RNULL DO
! List each monitor;
EMIT(PSDCODE,CMON:OFFSET[LLOP(C)],CONST); ! offset;
IF BLOCK:CMONS[PARSETREE] ≠ RNULL
THEN EMIT(PSDCODE,0,CONST); ! zero at end of cond. mon. list;
! Get rid of force variables;
C ← BLOCK:FORCES[PARSETREE];
WHILE C ≠ RNULL DO
BEGIN
EMIT(PSDCODE,DESFORCE_PSOP,PSINST);
EMIT(PSDCODE,FORCE:OFFSET[LLOP(C)],CONST); ! offset;
END;
! Get rid of non-global variables;
C ← BLOCK:VARS[PARSETREE];
IF C ≠ RNULL
THEN EMIT(PSDCODE,KVAR_PSOP,PSINST);
WHILE C ≠ RNULL DO
BEGIN "varrem"
VARBL ← LLOP(C);
IF ¬GLBAL_ON(VARIABLE:ATTRIBUTES[VARBL])
THEN ! List each non-global variable;
EMITOFFSET(PSDCODE,VARBL);
END "varrem";
IF BLOCK:VARS[PARSETREE] ≠ RNULL
THEN EMIT(PSDCODE,0,CONST); ! zero at end of variable list;
! Get rid of events;
C ← BLOCK:EVTS[PARSETREE];
IF C ≠ RNULL
THEN EMIT(PSDCODE,DESEVT_PSOP,PSINST); ! variable removal;
WHILE C ≠ RNULL DO
! List each event;
EMITOFFSET(PSDCODE,LLOP(C));
IF BLOCK:EVTS[PARSETREE] ≠ RNULL
THEN EMIT(PSDCODE,0,CONST); ! zero at end of event list;
MAKE_REMARK(PSDCODE,"End of BLOCK");
OFS ← SAVOFS; ! Restore the offset to original state;
END "block"
! TSCAN: COBLOCK;
ELSE IF STYP = LOC(COBLOCK) THEN
BEGIN "coblock"
RCLASS COLAB (INTEGER LBEL; RPTR(COLAB) NEXT);
RPTR (COLAB) LABELS, HERE;
INTEGER SAVOFS; ! Holds OFS for the duration;
RCELL C;
PRELOAD_WITH JUMP_PSOP, DUMMY, ! 1-2;
SPROUT_PSOP, DUMMY, ! 3-4;
TERMINATE_PSOP, ! 5;
DUMMY; ! 6;
INTEGER OWN ARRAY DATA[1:6];
PRELOAD_WITH PSINST, SYMREF, ! 1-2;
PSINST, SYMREF, ! 3-4;
PSINST, ! 5;
SYMDEC; ! 6;
INTEGER OWN ARRAY RELOC[1:6];
HERE ← LABELS ← NEW_RECORD (COLAB);
LAB1 ← DATA[2] ← GENLABEL;
MAKE_REMARK(PSDCODE,"COBLOCK");
EMIT(PSDCODE,DATA[1],RELOC[1],2); ! Jump to end label;
SAVOFS ← OFS;
OFS ← (OFS LAND '17400) + '410; ! Move to next lexical level, offset 10;
C ← COBLOCK:CODE[PARSETREE];
WHILE C ≠ RNULL DO
BEGIN "onecob"
HERE ← COLAB:NEXT[HERE] ← NEW_RECORD(COLAB);
DATA[6] ← COLAB:LBEL[HERE] ← GENLABEL;
EMIT(PSDCODE,DATA[6],RELOC[6],1); ! symdec;
MAKE_REMARK(PSDCODE," COSTATEMENT");
TSCAN(LLOP(C));
EMIT(PSDCODE,DATA[5],RELOC[5],1); ! Terminate;
END "onecob";
OFS ← SAVOFS; ! Back to previous level;
DATA[6] ← LAB1; ! Label for jump around cocode;
EMIT(PSDCODE,DATA[6],RELOC[6],1); ! symdec;
HERE ← COLAB:NEXT[LABELS];
MAKE_REMARK(PSDCODE," EPILOG OF COBLOCK");
EMIT(PSDCODE,DATA[3],RELOC[3],1); ! Sprout;
WHILE HERE ≠ RNULL DO
BEGIN
DATA[4] ← COLAB:LBEL[HERE];
EMIT(PSDCODE,DATA[4],RELOC[4],1); ! Label of code;
HERE ← COLAB:NEXT[HERE];
END;
EMIT(PSDCODE,0,CONST,1); ! Final zero;
MAKE_REMARK(PSDCODE,"END COBLOCK");
END "coblock"
! TSCAN: FORR, WHIL, IFF;
ELSE IF STYP = LOC(FORR) THEN
BEGIN "forr"
! This is how it all should look: [FOR LOOP] <stack initial,
final, step> LAB1: XCOPY 2 (current value) XCHNGE <control
variable> XFORCHK LAB2 <body> XCOPY 0 (step size) XCOPY 3
(current value) XSADD XREPLACE 3 (current value) XJUMP LAB1
LAB2: XPOP XPOP XPOP [END FOR];
MAKE_REMARK(PSDCODE,"FOR LOOP");
EMITEXPR(FORR:INITIAL[PARSETREE]);
! This will emit code for the calculation of the initial
value;
EMITEXPR(FORR:FINAL[PARSETREE]);
! This will emit code for the calculation of the final
value;
EMITEXPR(FORR:STEP[PARSETREE]);
! This will emit code for the calculation of the step
value;
LAB1 ← GENLABEL; ! Top of loop;
LAB2 ← GENLABEL; ! End of loop;
EMIT(PSDCODE,LAB1,SYMDEC);
EMIT(PSDCODE,COPY_PSOP,PSINST);
EMIT(PSDCODE,2,CONST);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,FORR:CONVAR[PARSETREE]);
EMIT(PSDCODE,FORCHK_PSOP,PSINST);
EMIT(PSDCODE,LAB2,SYMREF);
TSCAN(FORR:BODY[PARSETREE]);
EMIT(PSDCODE,COPY_PSOP,PSINST);
EMIT(PSDCODE,0,CONST);
EMIT(PSDCODE,COPY_PSOP,PSINST);
EMIT(PSDCODE,3,CONST);
EMIT(PSDCODE,SADD_PSOP,PSINST);
EMIT(PSDCODE,REPLACE_PSOP,PSINST);
EMIT(PSDCODE,3,CONST);
EMIT(PSDCODE,JUMP_PSOP,PSINST);
EMIT(PSDCODE,LAB1,SYMREF);
EMIT(PSDCODE,LAB2,SYMDEC);
EMIT(PSDCODE,POP_PSOP,PSINST);
EMIT(PSDCODE,POP_PSOP,PSINST);
EMIT(PSDCODE,POP_PSOP,PSINST);
MAKE_REMARK(PSDCODE,"END FOR");
END "forr"
ELSE IF STYP = LOC(WHIL) THEN
BEGIN "while"
PRELOAD_WITH JUMP_PSOP, DUMMY, DUMMY; ! 1-3;
INTEGER OWN ARRAY DATA[1:3];
PRELOAD_WITH PSINST, SYMREF, SYMDEC; ! 1-3;
INTEGER OWN ARRAY RELOC[1:6];
MAKE_REMARK(PSDCODE,"WHILE LOOP");
LAB1 ← DATA[2] ← GENLABEL; ! Loop head;
LAB2 ← DATA[3] ← GENLABEL; ! After end;
EMIT(PSDCODE,LAB1,SYMDEC); ! (dec) LAB1: ;
EMITBOOL(WHIL:COND[PARSETREE],0,LAB2);
TSCAN(WHIL:BODY[PARSETREE]);
EMIT(PSDCODE,DATA[1],RELOC[1],3); ! JUMP (ref) LAB1, (dec) LAB2: ;
MAKE_REMARK(PSDCODE,"END WHILE");
END "while"
ELSE IF STYP = LOC(IFF) THEN
BEGIN "iff"
PRELOAD_WITH JUMP_PSOP, DUMMY, DUMMY; ! 1-3;
INTEGER OWN ARRAY DATA[1:3];
PRELOAD_WITH PSINST, SYMREF, SYMDEC; ! 1-3;
INTEGER OWN ARRAY RELOC[1:3];
MAKE_REMARK(PSDCODE,"IF");
LAB1 ← DATA[3] ← GENLABEL; ! The head of the ELSE part;
LAB2 ← DATA[2] ← GENLABEL; ! At the end of the IF;
EMITBOOL(IFF:COND[PARSETREE],0,LAB2);
MAKE_REMARK(PSDCODE,"THEN");
TSCAN(IFF:THN[PARSETREE]);
EMIT(PSDCODE,DATA[1],RELOC[1],3); ! JUMP (ref) LAB2, (dec) LAB1: ;
IF IFF:ELS[PARSETREE] ≠ NULL
THEN BEGIN
MAKE_REMARK(PSDCODE,"ELSE");
TSCAN(IFF:ELS[PARSETREE]);
END;
EMIT(PSDCODE,LAB2,SYMDEC); ! (dec) LAB2: ;
MAKE_REMARK(PSDCODE,"FI");
END "iff"
ELSE GO TO MIDLABEL;
GO TO ENDLABEL; ! This is to avoid parse stack overflow;
! TSCAN: ASSIGNMENT, PRNT, GASSIGN, ALSODO;
MIDLABEL: ! Necessary to avoid parse stack overflow;
IF STYP = LOC(ASSIGNMENT) THEN
BEGIN "assignment"
MAKE_REMARK(PSDCODE,"Assignment");
! Get the value on the stack;
EMITEXPR(ASSIGNMENT:VAL[PARSETREE]);
! Emit "change variable to value on stack";
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,ASSIGNMENT:VAR[PARSETREE]);
END "assignment"
ELSE IF STYP = LOC(PRNT) THEN
BEGIN "prnt"
MAKE_REMARK(PSDCODE,"Print");
! Get the value on the stack;
EMITEXPR(PRNT:VAL[PARSETREE]);
EMIT(PSDCODE,VALPRN_PSOP,PSINST);
END "prnt"
ELSE IF STYP = LOC(GASSIGN) THEN
BEGIN "gassign"
! Only handles GASSIGN:OP = 1 or 2 (is / is not computed by);
RPTR(CALCULATOR,LBLVAR) CLCV;
IF GASSIGN:OP[PARSETREE] = 1
THEN EMIT(PSDCODE,MCLC_PSOP,PSINST) ! Is calculated by;
ELSE IF GASSIGN:OP[PARSETREE] = 2
THEN EMIT(PSDCODE,DCLC_PSOP,PSINST) ! Is not calculated by;
ELSE COMERR("Illegal GASSIGN",PARSETREE);
CLCV ← GASSIGN:CLC[PARSETREE];
IF RECTYPE(CLCV) = LOC(LBLVAR)
THEN CLCV ← LBLVAR:SEMANTICS[CLCV];
EMIT(PSDCODE,CALCULATOR:OFFSET[CLCV],CONST);
EMITOFFSET(PSDCODE,GASSIGN:VAR[PARSETREE]);
END "gassign"
ELSE IF STYP = LOC(ALSODO) THEN
BEGIN "alsodo"
! MCHG_PSOP <offset> (symref LAB1) JUMP_PSOP (symref LAB2)
LAB1: <code for changer> TERMINATE_PSOP LAB2: ;
RPTR(CHANGER,LBLVAR) CHGV;
MAKE_REMARK(PSDCODE,"Also do");
LAB1 ← GENLABEL; ! Start of changer code;
LAB2 ← GENLABEL; ! End of changer code;
EMIT(PSDCODE,MCHG_PSOP,PSINST);
EMITOFFSET(PSDCODE,ALSODO:VAR[PARSETREE]);
EMIT(PSDCODE,LAB1,SYMREF);
EMIT(PSDCODE,JUMP_PSOP,PSINST);
EMIT(PSDCODE,LAB2,SYMREF);
EMIT(PSDCODE,LAB1,SYMDEC);
CHGV ← ALSODO:CHG[PARSETREE];
IF RECTYPE(CHGV) = LOC(LBLVAR)
THEN CHGV ← LBLVAR:SEMANTICS[CHGV];
TSCAN(CHANGER:CODE[CHGV]);
EMIT(PSDCODE,TERMINATE_PSOP,PSINST);
EMIT(PSDCODE,LAB2,SYMDEC);
END "alsodo"
! TSCAN: CMON, CMABLE;
ELSE IF STYP = LOC(CMON) THEN
BEGIN "cmon"
MAKE_REMARK(PSDCODE,"Enable condition monitor");
EMIT(PSDCODE,CMENBL_PSOP,PSINST);
EMIT(PSDCODE,CMON:OFFSET[PARSETREE],CONST);
END "cmon"
ELSE IF STYP = LOC(CMABLE) THEN
BEGIN "cmable"
RPTR(CMON,LBLVAR) CMONV; ! The CMON;
CMONV ← CMABLE:WHAT[PARSETREE];
IF RECTYPE(CMONV) = LOC(LBLVAR)
THEN CMONV ← LBLVAR:SEMANTICS[CMONV];
IF CMABLE:FLAG[PARSETREE]
THEN BEGIN "enable"
MAKE_REMARK(PSDCODE,"Enable");
EMIT(PSDCODE,CMENBL_PSOP,PSINST); ! CMENBL (offset);
EMIT(PSDCODE,CMON:OFFSET[CMONV],CONST);
END "enable"
ELSE BEGIN "disable"
MAKE_REMARK(PSDCODE,"Disable");
EMIT(PSDCODE,CMDSBL_PSOP,PSINST); ! CMDSBL (offset);
EMIT(PSDCODE,CMON:OFFSET[CMONV],CONST);
END "disable"
END "cmable"
! TSCAN: MOVE$, CENTER, STOP, COMMENT, AFFIX, UNFIX;
ELSE IF STYP = LOC(MOVE$) THEN
BEGIN "move"
RPTR(DEXPR) DESTEXPR; ! The destiniation expression;
RCELL CLAUS; ! The list of clauses;
MAKE_REMARK(PSDCODE,"Move");
! Generate code for all via points that are expressions;
CLAUS ← MOVE$:CLAUSES[PARSETREE];
WHILE CLAUS ≠ RNULL DO
BEGIN "mvia"
RANY THISCLAUSE;
THISCLAUSE ← LLOP(CLAUS);
IF RECTYPE(THISCLAUSE) = LOC(VIA) AND
RECTYPE(DEXPR:EXPN[VIA:ACTPLACE[THISCLAUSE]]) = LOC(EXPRN)
THEN BEGIN "movvia"
EMITEXPR(DEXPR:EXPN[VIA:ACTPLACE[THISCLAUSE]]);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,DEXPR:VAR[VIA:ACTPLACE[THISCLAUSE]]);
END "movvia";
END "mvia";
! Generate code for the destination point, if it is an expression;
DESTEXPR ← MOVE$:DEXP[PARSETREE];
IF RECTYPE(DEXPR:EXPN[DESTEXPR]) = LOC(EXPRN)
THEN BEGIN "movdest" ! Must emit code to evaluate the
destination;
EMITEXPR(DEXPR:EXPN[DESTEXPR]);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,DEXPR:VAR[DESTEXPR]);
END "movdest";
TRJCLC(PARSETREE,STMNT:IW[STATEMENT]);
END "move"
ELSE IF STYP = LOC(OPERATE) THEN
BEGIN "operate"
RPTR(MOVE$) MOV; ! Fill this in from the OPERATE record;
RPTR(DEXPR) DESTEXPR; ! The destiniation expression;
RCELL CLAUS; ! The list of clauses;
MAKE_REMARK(PSDCODE,"Operate");
IF OPERATE:WHAT[PARSETREE] ≠ BHAND AND
OPERATE:WHAT[PARSETREE] ≠ YHAND
THEN COMERR("Can't OPERATE a non-hand");
MOV ← NEW_RECORD(MOVE$);
MOVE$:WHAT[MOV] ← OPERATE:WHAT[PARSETREE];
MOVE$:DEST[MOV] ← OPERATE:DEST[PARSETREE];
MOVE$:CLAUSES[MOV] ← OPERATE:CLAUSES[PARSETREE];
MOVE$:CF[MOV] ← OPERATE:CF[PARSETREE];
MOVE$:DEXP[MOV] ← OPERATE:DEXP[PARSETREE];
! Generate code for all via points that are expressions;
CLAUS ← MOVE$:CLAUSES[MOV];
WHILE CLAUS ≠ RNULL DO
BEGIN "ovia"
RANY THISCLAUSE;
THISCLAUSE ← LLOP(CLAUS);
IF RECTYPE(THISCLAUSE) = LOC(VIA) AND
RECTYPE(DEXPR:EXPN[VIA:ACTPLACE[THISCLAUSE]]) = LOC(EXPRN)
THEN BEGIN "oprvia"
EMITEXPR(DEXPR:EXPN[VIA:ACTPLACE[THISCLAUSE]]);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,DEXPR:VAR[VIA:ACTPLACE[THISCLAUSE]]);
END "oprvia";
END "ovia";
! Generate code for the destination point, if it is an expression;
DESTEXPR ← MOVE$:DEXP[MOV];
IF RECTYPE(DEXPR:EXPN[DESTEXPR]) = LOC(EXPRN)
THEN BEGIN "oprdest" ! Must emit code to evaluate the
destination;
EMITEXPR(DEXPR:EXPN[DESTEXPR]);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,DEXPR:VAR[DESTEXPR]);
END "oprdest";
TRJCLC(MOV,STMNT:IW[STATEMENT]);
END "operate"
ELSE IF STYP = LOC(CENTER) THEN
BEGIN "center"
MAKE_REMARK(PSDCODE,"Center");
CENTCLC(PARSETREE);
END "center"
ELSE IF STYP = LOC(STOP) THEN
BEGIN "stop"
MAKE_REMARK(PSDCODE,"Stop");
STOPCLC(PARSETREE);
END "stop"
ELSE IF STYP = LOC(COMMNT) THEN
BEGIN "commnt"
END "commnt"
ELSE IF STYP = LOC(AFFIX) THEN
BEGIN "affix"
RCELL C;
MAKE_REMARK(PSDCODE,"Affixment");
C ← AFFIX:GPHCODE[PARSETREE];
WHILE C ≠ RNULL DO
BEGIN "afscan"
TSCAN(LLOP(C));
END "afscan";
MAKE_REMARK(PSDCODE,"End of affixment");
END "affix"
ELSE IF STYP = LOC(UNFIX) THEN
BEGIN "unfix"
RCELL C;
MAKE_REMARK(PSDCODE,"Unfixment");
C ← UNFIX:GPHCODE[PARSETREE];
WHILE C ≠ RNULL DO
BEGIN "afscan"
TSCAN(LLOP(C));
END "afscan";
MAKE_REMARK(PSDCODE,"End of unfixment");
END "unfix"
! TSCAN: EVDO, SPECVAL;
ELSE IF STYP = LOC(EVDO) THEN
BEGIN "evdo"
MAKE_REMARK(PSDCODE,"Event operation");
IF EVDO:OP[PARSETREE] = 0
THEN EMIT(PSDCODE,SIGNAL_PSOP,PSINST)
ELSE EMIT(PSDCODE,WAITE_PSOP,PSINST);
EMITOFFSET(PSDCODE,EVDO:VAR[PARSETREE]);
END "evdo"
ELSE IF STYP = LOC(SPECVAL) THEN
BEGIN "specval"
IF SPECVAL:OLD[PARSETREE] = TRUE
THEN EMIT(PSDCODE,GTOLD_PSOP,PSINST)
ELSE EMIT(PSDCODE,GTNEW_PSOP,PSINST);
END "specval"
! NULL, UNRECOGNIZED, Matching ENDs;
ELSE IF STYP = LOC(BLKOP) OR
STYP = LOC(ASSERT) OR
STYP = LOC(DENY) OR
STYP = LOC(PVL) OR
STYP = LOC(NW) THEN ! No-op at the moment;
ELSE COMERR("Can't generate code for this",PARSETREE);
ENDLABEL: ! This is here to avoid parse stack overflow;
END "tscan";
END $$prgid;
! Bugs
Global events will not work.
offsets are reused inside parallel blocks. This is wrong.
iw=ow=any after a condition monitor
;